home *** CD-ROM | disk | FTP | other *** search
/ Aminet 30 / Aminet 30 (1999)(Schatztruhe)[!][Apr 1999].iso / Aminet / dev / amos / sillysource2.lha / GIN RUMMY.AMOS / GIN RUMMY.amosSourceCode < prev    next >
AMOS Source Code  |  1996-08-26  |  6KB  |  132 lines
  1. 10 Screen Open 1,320,200,16,Lowres : Screen Hide 1 : Curs Off : Hide On : Flash Off : Break Off 
  2. 20 Dim DEAL(13),CARDS(55),CARDX(7),C1$(14),DEAL$(15,7) : Track Loop On 
  3. 25 Unpack 6 To 1 : Wait Vbl : FU$=Str$(Rnd(4)+1) : Gosub 900 : FU$="" : Wait 20 : While Mouse Key=0 : Wend : Fade 3 : Wait 60 : Cls 
  4. 26 For X=1 To 15 : For Y=1 To 7
  5. 27 Read A : DEAL$(X,Y)=Str$(A)
  6. 28 Next Y : Next X
  7. 30 Unpack 5 To 1 : Paper 0
  8. 40 GO=0 : RT=Rnd(25)+5 : GOO=0
  9. 41 Home : Print "COMPUTER";CSC;"  ";"PLAYER";PLSC
  10. 45 Cls 0,0,11 To 330,160
  11. 50 Gosub 500 : Gosub 5000
  12. 60 Reserve Zone 16 : For X=1 To 300 Step 46 : Inc Z : CARDX(Z)=X : Set Zone Z,X,2 To X+40,58 : Next X
  13. 65 Set Zone 8,5,176 To 61,192 : Set Zone 9,65,176 To 120,192 : Set Zone 10,124,176 To 180,192 : Set Zone 11,183,176 To 238,192 : Set Zone 12,241,176 To 298,192 : Set Zone 13,303,176 To 314,194
  14. 70 Set Zone 14,120,80 To 160,135 : Set Zone 15,168,80 To 210,135
  15. 100 Rem SHOW PLAYERS CARDS 
  16. 110 CARD=0 : Z=0
  17. 120 For X=1 To 300 Step 46 : Inc CARD : Paste Bob X,11,CARDS(CARD) : Next X
  18. 130 Paste Bob 120,80,53 : Paste Bob 168,80,CARDS(8) : CARD=8
  19. 140 Locate 0,19 : Print Space$(40) : Locate 0,19 : Centre "SELECT AN OPTION"
  20. 150 Show On : Wait 30 : Repeat 
  21. 153 CH=Mouse Zone
  22. 154 FU$=Inkey$ : If Val(FU$)>0 Then Gosub 900
  23. 156 Wait Vbl : Until Mouse Key=1 and CH>7 and CH<14
  24. 160 If CH=8 and GOO=0 Then GOO=1 : Goto 200
  25. 170 If CH=9 Then Goto 150
  26. 180 If CH=10 Then Goto 400
  27. 190 If CH=11 and GOO=1 Then GOO=0 : Gosub 4000 : Goto 140
  28. 195 If CH=12 Then Locate 0,19 : Print Space$(40) : Locate 0,19 : Centre "BYE BYE SWEETIE" : Wait 100 : Fade 2 : Wait 40 : Track Stop : End 
  29. 196 If CH=13 Then Goto 600
  30. 197 Goto 150
  31. 200 Rem TAKE A CARD
  32. 210 Locate 0,19 : Centre "CHOOSE A CARD TO TAKE" : Inc GO
  33. 220 Wait 20 : Repeat : CH1=Mouse Zone
  34. 222 Wait Vbl : Until Mouse Key=1 and CH1>13
  35. 225 If CARD>=51 Then CARD=8
  36. 230 If CH1=14 Then Inc CARD : Bob 1,60,80,CARDS(CARD) : A=1
  37. 235 If CH1=15 Then Goto 270
  38. 240 Locate 0,19 : Centre "TAKE OR THROW THIS CARD?"
  39. 250 Wait 20 : Repeat : CH=Mouse Zone : Wait Vbl : Until Mouse Key=1 and CH>7 and CH<10
  40. 260 If CH=9 and A=1 Then Bob Off : Paste Bob 168,80,CARDS(CARD) : Locate 0,19 : Print Space$(40) : A=0 : Goto 140
  41. 270 Rem REPLACE A CARD 
  42. 280 Locate 0,19 : Centre "CHOOSE A CARD TO REPLACE THIS CARD"
  43. 290 Wait 20 : Repeat : CH2=Mouse Zone : Wait Vbl : Until Mouse Key=1 and CH2>0 and CH2<8
  44. 300 Rem REPLACE CHOSEN CARD
  45. 310 XC=CARDX(CH2) : CA=CARDS(CARD) : Paste Bob XC,11,CA : Paste Bob 168,80,DEAL(CH2)
  46. 320 Bob Off : Swap CARDS(CARD),DEAL(CH2) : Locate 0,19 : Print Space$(40) : Inc GO : Goto 140
  47. 400 Rem SORT OUT HAND
  48. 410 Locate 0,19 : Centre "  CHOOSE A CARD  "
  49. 420 Wait 20 : Repeat : CH=Mouse Zone : Wait Vbl : Until Mouse Key=1 and CH>0 and CH<8 : SUSAN=CH : DEANO=CARDX(CH)
  50. 430 Locate 0,19 : Centre "CHOOSE A CARD TO SWAP WITH"
  51. 440 Wait 20 : Repeat : CH2=Mouse Zone : Wait Vbl : Until Mouse Key=1 and CH2>0 and CH2<8 : SUE=CH2 : DEAN=CARDX(CH2)
  52. 450 Swap DEAL(SUSAN),DEAL(SUE) : Paste Bob DEANO,11,DEAL(SUSAN) : Paste Bob DEAN,11,DEAL(SUE) : Locate 0,19 : Print Space$(40) : Goto 140
  53. 500 Rem
  54. 510 S=1 : COUNT=0 : Repeat 
  55. 520 For X=1 To 4 : C$=C$+Str$(S) : S=S+13 : Next X
  56. 530 Inc COUNT : C1$(COUNT)=C$ : C$="" : S=COUNT+1 : Until COUNT=13
  57. 580 Return 
  58. 600 Rem HAND PUT DOWN
  59. 610 SET=0 : CHECK=1 : F3=0
  60. 615 C$="" : C$=C1$(CHECK)+" 99 " : FOUND=0
  61. 620 For X=1 To 7
  62. 630 A$="" : A$=Str$(DEAL(X))+" "
  63. 640 D=Instr(C$,A$,Abs(-1)) : If D Then Inc FOUND
  64. 645 Remhome : print CHECK,X,A$,C$,FOUND,D;"      " : wait key
  65. 650 Next X
  66. 660 If FOUND=4 Then FOUND=0 : Inc CHECK : Inc SET : Goto 615
  67. 670 If FOUND=3 and F3=0 Then FOUND=0 : Inc CHECK : Inc SET : F3=1 : Goto 615
  68. 680 If CHECK<13 Then Inc CHECK : Goto 615
  69. 690 If SET=2 Then Locate 0,19 : Centre "YOU HAVE WON THE GAME" : Wait 100 : Locate 0,19 : Print Space$(40) : FF=0 : Inc PLSC : Goto 40
  70. 800 Rem CHECK FOR CARDS IN ORDER OF SUIT 
  71. 810 ST=1 : EN=13 : CH$="" : D=0 : F3=0
  72. 820 For X=ST To EN : CH$=CH$+Str$(X) : Next X
  73. 830 FOUND=0 : CH$=CH$+" 99"
  74. 845 For X=1 To 7
  75. 850 A$="" : A$=Str$(DEAL(X))+" "
  76. 860 D=Instr(CH$,A$)
  77. 870 If D=0 and FOUND=3 and F3=0 Then F3=1 : Goto 890
  78. 872 If D=0 and FOUND=4 Then Goto 890
  79. 873 If D=0 and FOUND<3 Then FOUND=0
  80. 874 If D Then Inc FOUND
  81. 875 RemHome : Print X,FOUND,SET;"               " : Wait 20
  82. 880 Next X
  83. 890 If FOUND=3 or FOUND=4 Then Inc SET
  84. 891 If FOUND=7 Then SET=2
  85. 895 If SET=2 Then Locate 0,19 : Centre "YOU HAVE WON THE GAME" : Wait 100 : Locate 0,19 : Print Space$(40) : FF=0 : Inc PLSC : Goto 40
  86. 896 If EN<52 Then ST=ST+13 : EN=EN+13 : D=0 : CH$="" : Goto 820
  87. 897 If SET=0 or SET=1 Then Locate 0,18 : Centre "YOU DON'T HAVE A FULL SET" : Locate 0,19 : Centre "OR YOUR HAND IS NOT IN ORDER" : Wait 200 : Locate 0,18 : Print Space$(40) : Locate 0,19 : Print Space$(40) : Goto 140
  88. 898 Goto 897
  89. 900 Rem MUSIC
  90. 910 If Val(FU$)>5 Then Return 
  91. 920 Track Stop : Erase 10 : M$="" : M$="MUSIC"+FU$-" "+".MOD"
  92. 940 Track Load M$,10
  93. 950 Track Play 10 : Return 
  94. 1000 Rem COMPUTERS WINNING HANDS
  95. 1010 Data 1,2,3,4,15,16,17
  96. 1020 Data 7,8,9,10,32,33,34
  97. 1030 Data 36,37,38,39,43,44,45
  98. 1040 Data 46,47,48,49,29,30,31
  99. 1050 Data 4,5,6,7,16,17,18
  100. 1060 Data 1,14,27,40,50,51,52
  101. 1070 Data 10,23,36,49,12,25,38
  102. 1080 Data 27,28,29,30,31,32,33
  103. 1090 Data 7,8,9,10,11,12,13
  104. 1100 Data 4,17,30,43,27,28,29
  105. 1110 Data 13,26,39,52,17,18,19
  106. 1120 Data 10,11,12,13,32,33,34
  107. 1130 Data 2,15,28,41,6,19,32
  108. 1140 Data 44,45,46,47,48,49,50
  109. 1150 Data 30,31,32,33,8,21,34
  110. 4000 Rem COMPUTERS GO 
  111. 4010 Locate 0,19 : Centre "COMPUTER PICKS UP A CARD" : Wait 80 : Locate 0,19 : Centre "COMPUTER PUTS A CARD DOWN" : Inc CARD : Paste Bob 168,80,CARDS(CARD) : Wait 80
  112. 4020 If GO=RT Then Locate 0,19 : Print Space$(40) : Gosub 4040 : Locate 0,19 : Centre "COMPUTER WINS THE GAME" : Wait 150 : Inc CSC : Goto 40
  113. 4030 Return 
  114. 4040 RA=Rnd(14)+1 : B=0
  115. 4050 Cls 0,0,11 To 330,80
  116. 4060 For X=1 To 300 Step 46 : Inc B : Wait Vbl : Paste Bob X,11,Val(DEAL$(RA,B)) : Next X
  117. 4070 B=0 : Return 
  118. 5000 Rem SORT RANDOM CARDS
  119. 5005 B=0 : A=0
  120. 5010 For X=1 To 52 : CARDS(X)=0 : Next X
  121. 5015 For X=1 To 13 : DEAL(X)=0 : Next X
  122. 5020 A=Rnd(51)+1
  123. 5030 For X=1 To 52
  124. 5040 If CARDS(X)=A Then Goto 5020
  125. 5050 Next X
  126. 5060 Inc B : CARDS(B)=A
  127. 5070 If B<52 Then Goto 5020
  128. 5080 For X=1 To 7 : A=CARDS(X) : DEAL(X)=A : Next X
  129. 5090 Return 
  130. 9000 Rem ERRORS 
  131. 9010 If Errn=13 Then Resume 140
  132. 9020 Resume 240